home *** CD-ROM | disk | FTP | other *** search
/ Shareware Grab Bag / Shareware Grab Bag.iso / 050 / bublsort.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1985-06-07  |  1.5 KB  |  61 lines
  1. PROGRAM Bubble;
  2. CONST
  3.   Maxlength = 1000;
  4. VAR
  5.   size : integer;
  6.   a    : ARRAY [1..Maxlength] of integer;
  7. (* =================================== *)
  8. PROCEDURE Get_Information;
  9. VAR
  10.   i :  integer;
  11. BEGIN
  12.   Writeln;
  13.   Writeln('                            PASCAL BUBBLE SORT');Writeln;
  14.   Writeln('      ---- A Sample Program for Beginning TURBO Pascal Programmers ----');
  15.   Gotoxy(27,15);
  16.   Writeln('Sorts Up to 1000 Integers');
  17.   Gotoxy(23,19);
  18.   Write('Enter number of digits to be sorted: ');
  19.   Readln(size);Delay(1000);clrscr;
  20.   Writeln('                  Type each integer (32767 max) on a line.');writeln;
  21.   FOR i := 1 to size DO
  22.     BEGIN
  23.        Gotoxy(35,12); Write('ENTRY # ',i:4,' : ');Clreol;
  24.        Readln(a[i]);Gotoxy(65,3);Write(size-i:4,' left to go.');
  25.     END;
  26. END;
  27. (* =================================== *)
  28. PROCEDURE Bubble_Sort;
  29. VAR
  30.   i,q,t  : integer;
  31. BEGIN
  32.   FOR i := size-1 DOWNTO 1 DO
  33.     FOR q := 1 to i DO
  34.     IF a[q] >= a[q+1] THEN
  35.        BEGIN
  36.          t := a[q+1];
  37.          a[q+1] := a[q];
  38.          a[q] := t;
  39.        END
  40. END;
  41. (* ================================== *)
  42. PROCEDURE Printout;
  43. VAR
  44.    q : integer;
  45. BEGIN
  46.   Writeln; Writeln;
  47.   FOR q := 1 to size DO
  48.     BEGIN
  49.       Writeln ('Position ',q:3,' is ',a[q]);
  50.     END;
  51.   Writeln;Writeln('TURBO is sure fast, isn''t it!!');
  52.   Writeln; Writeln('══ End of Program ══');
  53. END;
  54. (* =================================== *)
  55. BEGIN (*Main Program*)
  56.   Get_Information;
  57.   Bubble_Sort;
  58.   Printout;
  59. END.
  60. ND;
  61. (* =====